home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / rotate3d.src < prev    next >
Text File  |  1991-02-21  |  4KB  |  216 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ Rotate3D
  3. @ by Colin Meyer
  4. @ Based on Three-Dimensional Graphics in Turbo Pascal, Computer Language,
  5. @   September 1990.
  6. DIR
  7.   SROTATE
  8.     \<< 1 2 CF CF
  9. "Initial View:" DUP
  10. { ":Axis1:
  11. :\<)1:" {
  12. 1 8 } } INPUT SWAP
  13. { ":Axis2:
  14. :\<)2:" {
  15. 1 8 } } INPUT SWAP
  16. OBJ\-> DTAG SWAP DTAG
  17. DUP 3 ROLLD R3D ROT
  18. OBJ\-> DTAG SWAP DTAG
  19. DUP 3 ROLLD R3D
  20. SWAP 4 ROLL + 3
  21. ROLLD * SWAP NEG 6
  22. +
  23. "Distance viewed from:"
  24. "" INPUT OBJ\->
  25. "Rotation options:"
  26. {
  27. ":Start\<):
  28. :End\<):
  29. :inc:"
  30. { 1 9 } } INPUT
  31. OBJ\-> DTAG ROT DTAG
  32. ROT DTAG ROT 4 ROLL
  33. 5 ROLL 6 ROLL 7
  34. ROLL OBJ\-> DROP
  35. CLLCD
  36. "Rotate on new or 
  37. original axes?"
  38. 3 DISP { "NEW" ""
  39. "" "" "" "ORIG" }
  40. TMENU 0
  41.       DO DROP -1
  42. WAIT
  43.       UNTIL { 16.1
  44. 11.1 } SWAP POS DUP
  45. DUP
  46.         IF NOT
  47.         THEN 880 .1
  48. BEEP
  49.         END
  50.       END 0 MENU 1
  51. -
  52.       IF
  53.       THEN 1 SF
  54.       END CLLCD
  55. "Save as grobs for 
  56. later animation?"
  57. 3 DISP YN
  58.       IF
  59.       THEN 2 SF
  60.       END ROTATE 1 2
  61. CF CF
  62.     \>>
  63.   ANIMATE
  64.     \<< { # 0h # 0h }
  65. PVIEW
  66.       DO FRAMES OBJ\->
  67. 1 SWAP
  68.         START PICT
  69. { # 14h # Ah } ROT
  70. REPL
  71.         NEXT
  72.       UNTIL 0
  73.       END
  74.     \>>
  75.   SANIMATE
  76.     \<< DEPTH \->LIST
  77. 'FRAMES' STO ANIMATE
  78.     \>>
  79.   OCTO { {
  80. [ 0 1 1 ]
  81. [ 0 1 -1 ]
  82. [ 0 -1 -1 ]
  83. [ 0 -1 1 ]
  84. [ -1 0 0 ]
  85. [ 1 0 0 ]
  86. } { 1 2 2 3 3 4 4 1
  87. 5 1 5 2 5 3 5 4 6 1
  88. 6 2 6 3 6 4 } }
  89.   CONE { {
  90. [ 0 1 0 ]
  91. [ -.809 -1 .588 ]
  92. [ -.809 -1 -.588 ]
  93. [ .309 -1 -.951 ]
  94. [ 1 -1 0 ]
  95. [ .309 -1 .951 ]
  96. } { 1 2 1 3 1 4 1 5
  97. 1 6 2 6 2 3 3 4 4 5
  98. 5 6 } }
  99.   CUBE { {
  100. [ -1 1 1 ]
  101. [ 1 1 1 ]
  102. [ -1 -1 1 ]
  103. [ 1 -1 1 ]
  104. [ -1 1 -1 ]
  105. [ 1 1 -1 ]
  106. [ -1 -1 -1 ]
  107. [ 1 -1 -1 ]
  108. } { 1 2 2 4 4 3 3 1
  109. 5 6 6 8 8 7 7 5 1 5
  110. 2 6 4 8 3 7 } }
  111.   FRAMES 0
  112.   ROTATE
  113.     \<< \-> inc dst ax
  114. r pnts lines
  115.       \<<
  116.         IF 2 FS?
  117.         THEN ERASE
  118. OVER ax R3D r
  119.           IF 1 FS?
  120.           THEN SWAP
  121.           END *
  122. pnts SWAP dst NOBJ
  123. lines SKETCH PICT {
  124. # 3h # 0h }
  125. GROB 121 6 79EE60CE62DD81CD18B9B18B3039A3001B42A02AA6545045048AA209288AA0007F4E602A6EDD804D14B9A109209BA3001D42A02AAA54114504AAA20920A29000794EA0CEA2D5D0C508BAB10938929B0000000000000000000000000000000000
  126. REPL GRAPH HALT
  127.         ELSE 0 0
  128.         END \-> p1 p2
  129.         \<< ERASE {
  130. # 0h # 0h } PVIEW
  131.           FOR j j
  132. ax R3D r
  133.             IF 1
  134. FS?
  135.             THEN
  136. SWAP
  137.             END *
  138. pnts SWAP dst NOBJ
  139. lines ERASE SKETCH
  140.             IF 2
  141. FS?
  142.             THEN
  143. PICT p1 p2 SUB
  144.             END inc
  145.           STEP
  146.         \>>
  147.       \>>
  148.     \>>
  149.   R3D
  150.     \<<
  151. [[ 0 0 0 ]
  152.  [ 0 0 0 ]
  153.  [ 0 0 0 ]]
  154. OVER DUP 2 \->LIST 1
  155. PUT R\|v 3 MOD 1 +
  156. DUP 3 MOD 1 + ROT
  157. SIN LASTARG COS \->
  158. m1 m2 s c
  159.       \<< R\|^ m2 m2 2
  160. \->LIST c PUT m1 m1 2
  161. \->LIST c PUT m2 m1 2
  162. \->LIST s NEG PUT m1
  163. m2 2 \->LIST s PUT
  164.       \>>
  165.     \>>
  166.   NOBJ
  167.     \<< \-> r d
  168.       \<< { } R\|v OBJ\->
  169. 1 SWAP
  170.         START r d
  171. NVERT R\->C R\|^ + R\|v
  172.         NEXT R\|^
  173.       \>>
  174.     \>>
  175.   SKETCH
  176.     \<< SWAP 'PNTS'
  177. STO OBJ\-> 2 / 1 SWAP
  178.       START PNTS
  179. SWAP GET SWAP PNTS
  180. SWAP GET LINE
  181.       NEXT 'PNTS'
  182. PURGE
  183.     \>>
  184.   NVERT
  185.     \<< R\|v SWAP * V\->
  186. R\|^ DUP ROT + / DUP
  187. ROT * R\|v * R\|^
  188.     \>>
  189.   PPAR {
  190. (-4.09375,-2)
  191. (4.09375,2) X 0
  192. (0,0) FUNCTION Y }
  193.   YN
  194. \<< { "YES"
  195. GROB 21 8 000000000000000000000000000000000000000000000000
  196. GROB 21 8 000000000000000000000000000000000000000000000000
  197. GROB 21 8 000000000000000000000000000000000000000000000000
  198. GROB 21 8 000000000000000000000000000000000000000000000000
  199. "NO" } TMENU 0
  200.   DO DROP -1 WAIT
  201.   UNTIL { 16.1 11.1
  202. } SWAP POS DUP DUP
  203.     IF NOT
  204.     THEN 880 .1
  205. BEEP
  206.     END
  207.   END 0 MENU 1 -
  208. \>>
  209.   R\|v
  210. \<< DEPTH ROLLD
  211. \>>
  212.   R\|^
  213. \<< DEPTH ROLL
  214. \>>
  215. END
  216.